subroutine r2abij_t2aeim_wmbej_2_io(r2, t2,  & 
               icore, fact, ig)
!
use mod_ioff
use mod_size
use mod_iop
use mod_orbit 
implicit none
!
real*8, intent(in) :: fact
real*4, intent(in) :: r2(*), ig(*)
!
real*4, intent(inout) :: t2(*), icore(*)
!
integer :: i, j, a, b, nsize
integer :: i0, i1, i2, i3
integer, external :: idsymsoc
real*8, external :: dnrm2
!this is to do r2(ab,ij) = r2(abij) + Pab*Pij*t2(ae,im)*w(embj)
i0 = 1                 
i1 = i0 + nvvoo*isd 
i2 = i1 + nvvoo*isd   
i3 = i2 + nvvoo*isd
!====AAAA
!
! R2AAAAR: P(ij)P(ab)  T2AA(AE,IM)*WMBEJ(EM,BJ)+T2AB(Ae,Im)*WMBEJ(emBJ)
!
 call iexpso(t2(ioi3(1)), icore(i1), vrta, vrta, 0, 1, popa, popa, 0, 0, 1)
 call iexpso(icore(i1), icore(i0), vrta, vrta, 1, 0, popa, popa, 0, 1, 1)
 call sstgenso(icore(i0), icore(i1), nsize, vrta, vrta, &
             popa, popa, icore, 1, '1324')
 call getallso(icore(i3), 1, 'WMBEJAAA') 
 igpu = 1
 call myicopy_g(icore(i1), ig(i0), nvvoo)
 call myicopy_g(icore(i3), ig(i1), nvvoo) 
! call myicopy_g(wmbej(ioi4(1)), ig(i1), nvvoo) 
 call VpqmnVmnrs_to_Vpqrs(ig(i0), ig(i1), 1, 1, &
                vrta, popa, 1, vrta, popa, 1, &
                vrta, popa, 1, ig(i2), 1, 1.d0, 0.d0)
 igpu = 0
        !
 call sstgenso(t2(ioi3(2)), icore(i0), nsize, vrta, vrtb, &
              popa, popb, icore, 1, '1324')
 call getallso(icore(i3), 1, 'WMBEJBBA') 
 igpu = 1
 call myicopy_g(icore(i0), ig(i0), nvvoo)
 call myicopy_g(icore(i3), ig(i1), nvvoo) 
! call myicopy_g(wmbej(ioi4(6)), ig(i1), nvvoo) 
 call VpqmnVmnrs_to_Vpqrs(ig(i0), ig(i1), 1, 1, &
                vrtb, popb, 1, vrta, popa, 1, &
                vrta, popa, 1, ig(i2), 1, 1.d0, 1.d0)
 igpu = 0
 call myicopy_c(ig(i2), icore(i2), nvvoo)

 nsize = idsymsoc(1, vrta,vrta, 1, popa, popa, 1) 
! write(6,*)'norm of icore(i2)', dnrm2(nsize, icore(i2), 1)
 call sstgenso(icore(i2), icore(i1), nsize, vrta, popa, &
             vrta, popa, icore, 1, '2413')
! nsize = idsymsoc(1, vrta,vrta, 1, popa, popa, 1) 
! write(6,*)'norm of icore(i1)', dnrm2(nsize, icore(i1), 1)
 call iassymso(icore(i1), icore(i0), 1, popa, popa, vrta, vrta, 1)
 call itranspso(icore(i0), icore(i1), popa, popa, 1, vrta, vrta, 0, 1)
 call iassymso(icore(i1), icore(i0), 1, vrta, vrta, popa, popa, 0)
 
 call axpyso(nioi31, fact, icore(i0), 1, r2(ioi3(1)), 1)
!
!--------------------------------------------------------------------
!
! R2ABABR: SUM_mn T2AA(AE,IM)W(EM,bj)+T2AB(Ae,Im)W(embj)
!                +T2AB(Eb,Mj)W(EM,AI)+T2BB(be,jm)W(emAI)
!                -T2AB(Eb,Im)W(Em,Aj)*2
!                -T2AB(Ae,Mj)W(eM,bI)*2
!
 CALL IEXPSO(T2(ioi3(1)), ICORE(i1), vrta, vrta, 0, 1, popa, popa, 0, 0, 1)
 CALL IEXPSO(icore(i1),  ICORE(i0), vrta, vrta, 1, 0, popa, popa, 0, 1, 1)
 CALL SSTGENSO(ICORE(i0), ICORE(i1), nsize, vrta, vrta, &
             popa, popa, ICORE, 1, '1324')
 call getallso(icore(i3), 1, 'WMBEJAAB') 
 igpu = 1
 call myicopy_g(icore(i1), ig(i0), nvvoo)
 call myicopy_g(icore(i3), ig(i1), nvvoo) 
 !call myicopy_g(wmbej(ioi4(5)), ig(i1), nvvoo) 
 CALL VpqmnVmnrs_to_Vpqrs(ig(i0), ig(i1), 1, 1, &
                vrta, popa, 1, vrta, popa, 1, &
                vrtb, popb, 1, ig(i2), 1, 1.d0, 0.d0)
 igpu = 0
 CALL SSTGENSO(T2(ioi3(2)), ICORE(i1), nsize, vrta, vrtb, &
             popa, popb, icore, 1, '1324')
 call getallso(icore(i3), 1, 'WMBEJBBB') 
 igpu = 1
 call myicopy_g(icore(i1), ig(i0), nvvoo)
 call myicopy_g(icore(i3), ig(i1), nvvoo) 
 !call myicopy_g(wmbej(ioi4(3)), ig(i1), nvvoo) 
 CALL VpqmnVmnrs_to_Vpqrs(ig(i0), ig(i1), 1, 1, &
                vrtb, popb, 1, vrta, popa, 1, &
                vrtb, popb, 1, ig(i2), 1, 1.d0, 1.d0)
 igpu = 0 
 call getallso(icore(i3), 1, 'WMBEJAAA') 
 igpu = 1 
 !call myicopy_g(wmbej(ioi4(1)), ig(i0), nvvoo) 
 call myicopy_g(icore(i3), ig(i0), nvvoo) 
 call myicopy_g(icore(i1), ig(i1), nvvoo)
 CALL VmnpqVmnrs_to_Vpqrs(ig(i0), ig(i1), 1, 1, &
                vrta, popa, 1, vrta, popa, 1, &
                vrtb, popb, 1, ig(i2), 1, 1.d0, 1.d0)
 igpu = 0 !
 CALL IEXPSO(T2(ioi3(3)), ICORE(i1), vrtb, vrtb, 0, 1, popb, popb, 0, 0,1)
 CALL IEXPSO(icore(i1), ICORE(i0), vrtb, vrtb, 1, 0, popb, popb, 0, 1,1)
 CALL SSTGENSO(ICORE(i0), ICORE(i1), nsize, vrtb, vrtb, &
             popb, popb, ICORE, 1, '1324')
 call getallso(icore(i3), 1, 'WMBEJBBA') 
 igpu = 1
 call myicopy_g(icore(i3), ig(i0), nvvoo) 
 !call myicopy_g(wmbej(ioi4(6)), ig(i0), nvvoo) 
 call myicopy_g(icore(i1), ig(i1), nvvoo)
 CALL VmnpqVmnrs_to_Vpqrs(ig(i0), ig(i1), 1, 1, &
                vrtb, popb, 1, vrta, popa, 1, &
                vrtb, popb, 1, ig(i2), 1, 1.d0, 1.d0)
 call myicopy_c(ig(i2), icore(i2), nvvoo)
 igpu = 0       !
 CALL SSTGENSO(icore(i2), icore(i1), nsize, &
           vrta, popa, vrtb, popb,ICORE,1,'1324')
 CALL AXPYSO(nioi32, fact, ICORE(i1), 1, R2(ioi3(2)), 1)
!
!           -T2AB(Eb,Im)W(Em,Aj)
!           -T2AB(Ae,Mj)W(eM,bI)
 CALL SSTGENSO(T2(ioi3(2)), ICORE(i1), nsize, vrta, vrtb, &
                popa, popb, ICORE, 1, '2314')
 call getallso(icore(i3), 1, 'WMBEJABA') 
 igpu = 1
 call myicopy_g(icore(i1), ig(i0), nvvoo)
 call myicopy_g(icore(i3), ig(i1), nvvoo) 
 !call myicopy_g(wmbej(ioi4(2)), ig(i1), nvvoo) 
 CALL VpqmnVmnrs_to_Vpqrs(ig(i0), ig(i1), 1, 1, &
                vrta, popb, 1, vrtb, popa, 1, &
                vrta, popb, 1, ig(i2), 1, 1.d0, 0.d0)
 igpu = 0 
 call getallso(icore(i3), 1, 'WMBEJBAB') 
 igpu = 1 
  !
 call myicopy_g(icore(i3), ig(i0), nvvoo) 
 !call myicopy_g(wmbej(ioi4(4)), ig(i0), nvvoo) 
 call myicopy_g(icore(i1), ig(i1), nvvoo)
 CALL VmnpqVmnrs_to_Vpqrs(ig(i0), ig(i1), 1, 1, &
                vrtb, popa, 1, vrtb, popa, 1, &
                vrta, popb, 1, ig(i2), 1, 1.d0, 1.d0)
 igpu = 0
 call myicopy_c(ig(i2), icore(i2), nvvoo)       !
 CALL SSTGENSO(icore(i2), ICORE(i1),nsize, &
               vrtb, popa, vrta, popb, ICORE,1,'3124')
 CALL AXPYSO(nioi32, fact, ICORE(i1), 1, R2(ioi3(2)), 1)
!
!----------------------------------------------------------------------
!
! R2BBBBR: P(ij)P(ab)  T2BB(ae,im)*WMBEJ(em,bj)+T2AB(Ea,Mi)*WMBEJ(EMbj)
!
 CALL IEXPSO(T2(ioi3(3)), ICORE(i1), vrtb, vrtb, 0, 1, popb, popb, 0, 0, 1)
 CALL IEXPSO(icore(i1), ICORE(i0), vrtb, vrtb, 1, 0, popb, popb, 0, 1, 1)
 CALL SSTGENSO(ICORE(i0), ICORE(i1), nsize, vrtb, vrtb, &
             popb, popb, ICORE, 1, '1324')
 call getallso(icore(i3), 1, 'WMBEJBBB') 
 igpu = 1
 call myicopy_g(icore(i1), ig(i0), nvvoo)
 call myicopy_g(icore(i3), ig(i1), nvvoo) 
 !call myicopy_g(wmbej(ioi4(3)), ig(i1), nvvoo) 
 CALL VpqmnVmnrs_to_Vpqrs(ig(i0), ig(i1), 1, 1, &
                vrtb, popb, 1, vrtb, popb, 1, &
                vrtb, popb, 1, ig(i2), 1, 1.d0, 0.d0)
 igpu = 0!
 CALL SSTGENSO(T2(ioi3(2)), ICORE(i1),nsize, vrta, vrtb, &
             popa, popb, ICORE, 1, '1324')
 call getallso(icore(i3), 1, 'WMBEJAAB') 
 igpu = 1
 call myicopy_g(icore(i1), ig(i0), nvvoo)
 call myicopy_g(icore(i3), ig(i1), nvvoo) 
 !call myicopy_g(wmbej(ioi4(5)), ig(i1), nvvoo) 
 CALL VmnpqVmnrs_to_Vpqrs(ig(i0), ig(i1), 1, 1, &
                vrta, popa, 1, vrtb, popb, 1, &
                vrtb, popb, 1, ig(i2), 1, 1.d0, 1.d0)
 igpu = 0
 call myicopy_c(ig(i2), icore(i2), nvvoo)

 CALL SSTGENSO(icore(i2), ICORE(i1),nsize, vrtb, popb, &
             vrtb, popb, ICORE, 1, '2413')
 call iassymso(icore(i1), icore(i0), 1, popb, popb, vrtb, vrtb, 1)
 call itranspso(icore(i0), icore(i1), popb, popb, 1, vrtb, vrtb, 0, 1)
 call iassymso(icore(i1), icore(i0), 1, vrtb, vrtb, popb, popb, 0)
 
 call axpyso(nioi33, fact, icore(i0), 1, r2(ioi3(3)), 1)

!
return
end
